home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / lrnvb615 / example2.frm (.txt) < prev    next >
Visual Basic Form  |  1998-04-10  |  6KB  |  194 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSavings 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Savings Account"
  5.    ClientHeight    =   3915
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1485
  8.    ClientWidth     =   3150
  9.    BeginProperty Font 
  10.       Name            =   "MS Sans Serif"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    ForeColor       =   &H80000008&
  19.    LinkTopic       =   "Form1"
  20.    PaletteMode     =   1  'UseZOrder
  21.    ScaleHeight     =   3915
  22.    ScaleWidth      =   3150
  23.    Begin VB.CommandButton cmdClear 
  24.       Caption         =   "Clear &Boxes"
  25.       Height          =   495
  26.       Left            =   1680
  27.       TabIndex        =   10
  28.       Top             =   2520
  29.       Width           =   1215
  30.    End
  31.    Begin VB.CommandButton cmdExit 
  32.       Caption         =   "E&xit"
  33.       Height          =   495
  34.       Left            =   840
  35.       TabIndex        =   9
  36.       Top             =   3240
  37.       Width           =   1215
  38.    End
  39.    Begin VB.CommandButton cmdCalculate 
  40.       Caption         =   "&Calculate"
  41.       Height          =   495
  42.       Left            =   240
  43.       TabIndex        =   8
  44.       Top             =   2520
  45.       Width           =   1215
  46.    End
  47.    Begin VB.TextBox txtFinal 
  48.       Height          =   495
  49.       Left            =   1560
  50.       TabIndex        =   7
  51.       Top             =   1920
  52.       Width           =   1215
  53.    End
  54.    Begin VB.TextBox txtMonths 
  55.       Height          =   495
  56.       Left            =   1560
  57.       TabIndex        =   6
  58.       Top             =   1320
  59.       Width           =   1215
  60.    End
  61.    Begin VB.TextBox txtInterest 
  62.       Height          =   495
  63.       Left            =   1560
  64.       TabIndex        =   5
  65.       Top             =   720
  66.       Width           =   1215
  67.    End
  68.    Begin VB.TextBox txtDeposit 
  69.       Height          =   495
  70.       Left            =   1560
  71.       TabIndex        =   4
  72.       Top             =   120
  73.       Width           =   1215
  74.    End
  75.    Begin VB.Label Label4 
  76.       Caption         =   "Final Balance"
  77.       Height          =   495
  78.       Left            =   240
  79.       TabIndex        =   3
  80.       Top             =   1920
  81.       Width           =   1215
  82.    End
  83.    Begin VB.Label Label3 
  84.       Caption         =   "Number of Months"
  85.       Height          =   495
  86.       Left            =   240
  87.       TabIndex        =   2
  88.       Top             =   1320
  89.       Width           =   1215
  90.    End
  91.    Begin VB.Label Label2 
  92.       Caption         =   "Yearly Interest"
  93.       Height          =   495
  94.       Left            =   240
  95.       TabIndex        =   1
  96.       Top             =   720
  97.       Width           =   1215
  98.    End
  99.    Begin VB.Label Label1 
  100.       Caption         =   "Monthly Deposit"
  101.       Height          =   495
  102.       Left            =   240
  103.       TabIndex        =   0
  104.       Top             =   120
  105.       Width           =   1215
  106.    End
  107. Attribute VB_Name = "frmSavings"
  108. Attribute VB_GlobalNameSpace = False
  109. Attribute VB_Creatable = False
  110. Attribute VB_PredeclaredId = True
  111. Attribute VB_Exposed = False
  112. Option Explicit
  113. Dim Deposit As Single
  114. Dim Interest As Single
  115. Dim Months As Single
  116. Dim Final As Single
  117. Const vbKeyDecPt = 46
  118. Private Sub cmdCalculate_Click()
  119. Dim IntRate As Single
  120. Dim IntNew As Single
  121. Dim Fcn As Single, FcnD As Single
  122. 'Read the four text boxes
  123. Deposit = Val(txtDeposit.Text)
  124. Interest = Val(txtInterest.Text)
  125. IntRate = Interest / 1200
  126. Months = Val(txtMonths.Text)
  127. Final = Val(txtFinal.Text)
  128. 'Determine which box is blank
  129. 'Compute that missing value and put in text box
  130. If txtDeposit.Text = "" Then
  131. 'Deposit missing
  132.   Deposit = Final / (((1 + IntRate) ^ Months - 1) / IntRate)
  133.   txtDeposit.Text = Format(Deposit, "#####0.00")
  134. ElseIf txtInterest.Text = "" Then
  135. 'Interest missing - requires iterative solution
  136.   IntNew = (Final / (0.5 * Months * Deposit) - 1) / Months
  137.     IntRate = IntNew
  138.     Fcn = (1 + IntRate) ^ Months - Final * IntRate / Deposit - 1
  139.     FcnD = Months * (1 + IntRate) ^ (Months - 1) - Final / Deposit
  140.     IntNew = IntRate - Fcn / FcnD
  141.   Loop Until Abs(IntNew - IntRate) < 0.00001 / 12
  142.   Interest = IntNew * 1200
  143.   txtInterest.Text = Format(Interest, "##0.00")
  144. ElseIf txtMonths.Text = "" Then
  145. 'Months missing
  146.   Months = Log(Final * IntRate / Deposit + 1) / Log(1 + IntRate)
  147.   txtMonths.Text = Format(Months, "###.0")
  148. ElseIf txtFinal.Text = "" Then
  149. 'Final value missing
  150.   Final = Deposit * ((1 + IntRate) ^ Months - 1) / IntRate
  151.   txtFinal.Text = Format(Final, "#####0.00")
  152. End If
  153. End Sub
  154. Private Sub cmdClear_Click()
  155. 'Blank out text boxes
  156. txtDeposit.Text = ""
  157. txtInterest.Text = ""
  158. txtMonths.Text = ""
  159. txtFinal.Text = ""
  160. End Sub
  161. Private Sub cmdExit_Click()
  162. End Sub
  163. Private Sub txtDeposit_KeyPress(KeyAscii As Integer)
  164. 'Only allow number keys, decimal point, or backspace
  165. If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyDecPt Or KeyAscii = vbKeyBack Then
  166.   Exit Sub
  167.   KeyAscii = 0
  168.   Beep
  169. End If
  170. End Sub
  171. Private Sub txtFinal_KeyPress(KeyAscii As Integer)
  172. 'Only allow number keys, decimal point, or backspace
  173. If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyDecPt Or KeyAscii = vbKeyBack Then
  174.   Exit Sub
  175.   KeyAscii = 0
  176.   Beep
  177. End If
  178. End Sub
  179. Private Sub txtInterest_KeyPress(KeyAscii As Integer)
  180. 'Only allow number keys, decimal point, or backspace
  181. If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyDecPt Or KeyAscii = vbKeyBack Then
  182.   Exit Sub
  183.   KeyAscii = 0
  184.   Beep
  185. End If
  186. End Sub
  187. Private Sub txtMonths_KeyPress(KeyAscii As Integer)
  188. If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = 46 Or KeyAscii = vbKeyBack Then
  189.   Exit Sub
  190.   KeyAscii = 0
  191.   Beep
  192. End If
  193. End Sub
  194.